Sun Solutions 1997 April to September/Sun Solutions CD - APR '97 - SEP '97 (704-3778-12 Rev. H)(Sun Microsystems, Inc.)(1997).iso/products/bin/httpd/Solaris_2/cgi-jas

Text File | 1996-06-07 | 9KB | 338 lines

#!./perl
# ------------------------------------------------------------
# generic_mailer2.pl, by phil hooper ([e-mail])
#
#####################################################################
#
# Copyright & Disclaimer
# Original bits copyright Creative Dynamics, Inc, oct 1994
# Permission to distribute, use, modify, ridicule granted
# provided the Copyright and Disclaimer stays intact.
#
# This code is provided as-is, with no guarantee that it will
# do anything (or for that matter, there is no guarantee that
# it WON'T do anything, either).
#
#####################################################################
#
# unabashedly swiping code from Reuven M. Lerner and
# and James tappin (see below)...after all, james burke
# says nothing is ever invented, just assembled from bits...
# all this thing does is mail the contents of a form
# to the address specified in the 'mailto' widget
# of the form.  the widget names/values are dumped one per line into
# the email in the order they are specified in the form
# definition.  widget names and types are irrelevant except
# (of course) for the special cases:
#
# 1] the mailto widget specifies the mail address
#
#    e.g. <INPUT NAME="mailto" TYPE="hidden" VALUE="[e-mail]">
#
# 2]  any time a widget named "space" is encountered, a blank
#    line is inserted in the email instead of the value
#    for the field.
#
#    e.g.  <INPUT NAME="space" TYPE="hidden" VALUE="space">
#
# 3] the request widget is used as the mail subject (sorry
#    about 'request'...it was historical).
#
#    e.g. <INPUT NAME="request" TYPE="hidden" VALUE="spam order request">
#
# 4] the thanks_url widget can be used to replace the generic thank
#    you page with a url you specify
#
#     e.g. <INPUT NAME="thanks_url" TYPE="hidden" VALUE="/stuff/thanks.html">
#
# 5] REQUIRED keywords can be added to the widgets NAME to indicate
#    a value must be provided.
#    if the user did not enter anything into that widget,
#    then the form is not mailed and a page is displayed telling the
#    user which fields require values (by NAME, so you want the widget
#    name to be something obvious...the REQUIRED part is stripped off)
#
#    e.g. Your Name : <INPUT NAME="REQUIRED Your Name">
#         <BR>
#         Your Email: <INPUT NAME="REQUIRED Your Email">
# ---------------------------------------------------------------
# credits
# ---------------------------------------------------------------
# Form-mail.pl, by Reuven M. Lerner ([e-mail]).
# This is a rewrite of a program that was trashed by our power
# surge in the middle of February 1994.
# ---------------------------------------------------------------
# The CGI_HANDLERS deal with basic CGI POST or GET method request
# elements such as those delivered by an HTTPD form, i.e. a url
# encoded line of "=" separated key=value pairs separated by &'s

# Routines:
# get_request:    reads the request and returns both the raw and
#               processed version.
# url_decode:    URL decodes a string or array of strings
# html_header:    Transmits a HTML header back to the caller
# html_trailer: Transmits a HTML trailer back to the caller

# Author:
#     James Tappin: [e-mail]
#    School of Physics & Space Research University of Birmingham
#    Feb 1993.

# Copyright & Disclaimer.
#    This set of routines may be freely distributed, modified and
#    used, provided this copyright & disclaimer remains intact.
#    This package is used at your own risk, if it does what you
#    want, good; if it doesn't, modify it or use something else--but
#    don't blame me. Support level = negligable (i.e. mail bugs but
#    not requests for extensions)

# Usage:
#    &get_request;    will get the request and decode it into an
#             indexed array %rqpairs, the raw request is in
#             $request
#
#    ... = &url_decode(LIST); will return a URL decoded version of
#                     the contents of LIST
#

sub get_request {

    # Subroutine get_request reads the POST or GET form request from STDIN
    # into the variable  $request, and then splits it into its
    # name=value pairs in the associative array %rqpairs.
    # The number of bytes is given in the environment variable
    # CONTENT_LENGTH which is automatically set by the request generator.

    # Encoded HEX values and spaces are decoded in the values at this
    # stage.

    # $request will contain the RAW request. N.B. spaces and other
    # special characters are not handler in the name field.

    if ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
    } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
    $request = $ENV{'QUERY_STRING'};
    }


    @names = &url_decode(split(/[&=]/, $request));
    %rqpairs = @names;

}

sub url_decode {

#    Decode a URL encoded string or array of strings
#        + -> space
#        %xx -> character xx


    foreach (@_) {
    tr/+/ /;
    s/%(..)/pack("c",hex($1))/ge;
    }
    @_;
}

sub html_header {

    # Subroutine html_header sends to Standard Output the necessary
    # material to form an HHTML header for the document to be
    # returned, the single argument is the TITLE field.

    local($title) = @_;

    print "Content-type: text/html\n\n";
    print "<html><head>\n";
    print "<title>$title</title>\n";
    print "</head>\n<body>\n";
}

sub html_trailer {

    # subroutine html_trailer sends the trailing material to the HTML
    # on STDOUT.

    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
    = gmtime;

    local($mname) = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
             "Aug", "Sep", "Oct", "Nov", "Dec")[$mon];
    local($dname) = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
             "Sat")[$wday];

    #print "<p>\nGenerated by: <var>$0</var><br>\n";
    #print "Date: $hour:$min:$sec UT on $dname $mday $mname $year.<p>\n";
    print "</body></html>\n";
}

#
# --------- Everything above here is generic ---------
#

#
# Define fairly-constants
#

$mailprog = '/usr/lib/sendmail -t';

#
# Get the input, output header
#

&get_request;


#
# make sure nobody tries to execute a subshell
#

$rqpairs{'mailto'} =~ s/~!/ ~!/g;

#
# check for REQUIRED keyword.  Set flag if value is required
# but not provided, then put up a page and forget about sending
# mail
#

@check_reqs = @names;
for $i (0..$#check_reqs){
    $name = shift(@check_reqs);
    $value = shift(@check_reqs);

    if ($name =~ /REQUIRED/) {
        if ($value eq "") {
            $bad = $name;
            $bad =~ s/\s*REQUIRED\s*//;
        push(@missing, $bad);
    }
    }
}

if ($#missing >= 0) {
    &html_header('Generic Mailer (by [e-mail])');
    print "<H1>Missing Required Information</H1>\n";
    print "<HR>\n";
    print "<H3>Please provide values for the following:</H3>\n";
    print "<UL>\n";
    for $i (0..$#missing) {
    $field = shift(@missing);
    print "<LI> $field\n";
    }
    print "</UL>\n";
    print "<HR>\n";
    print "<H3>Go back and try again</H3>\n";

    &html_trailer;
    exit 0;
}

#
# Now send mail to $rqpairs{'mailto'};
#

open (MAIL, ">/home/jasoni/temp/cgimail.html");


for $i (0..$#names){

    $name = shift(@names);
    $value = shift(@names);

    $i++;

    if (($name ne "") && ($name ne 'mailto') && ($name ne 'thanks_url')) {

    if ($name ne "space") {


# be a little tidier if the $value has an embedded newline, print the
# whole thing starting on a seperate line.
#
        $name =~ s/\s*REQUIRED\s*//;

            if ($value =~ /\n/) {
        print MAIL "$value:";
        } else {
        print MAIL "$value:";
        }
    } else {
        print MAIL "\n";
    }
    }
}

#print MAIL "\n------------------------------------------------------------\n\n";
#print MAIL "Remote host: $ENV{'REMOTE_HOST'}\n";
#print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n";
close (MAIL);

#
# if they haven't provided a thank-you url, then print the
# default thank you page.  if they have provided an url ,then
# issue a redirect
#

   &html_header('(Table Viewer)');
   print "<H1>Please enter the data below! </H1>\n";
   print "<HR>";
   &html_trailer;


open (MAIL, "/home/jasoni/temp/cgimail.html");
open (RESPONSE, ">/home/jasoni/temp/preview.html");
while (<MAIL>)  {
chop;
($title,$columns,$rows,$border) = split(/:/);
print RESPONSE <<"end_print";
<html>
<head><title>Table Preview</title></head>
<body>
<center>
<form method="post" action="http://localhost:7999/cgi-bin/cgi-final">

<table border=$border>
<h2><center>$title</center></h2>
end_print
    }
$c = 0;
$r = 1;
while ($c < $columns) {
    print RESPONSE "<b><th><input type=text size=15 name=\"title$c\"></b></th>\n";
} continue {
    $c++;
}
$ctr=1;
while ($r < $rows) {
    $c=0;
    print RESPONSE "<tr>\n";
    while ($c < $columns)  {
    print RESPONSE "<td><input type=text  size=15 name=\"data$ctr\"></td>\n";
    }  continue {
        $c++;
        $ctr++;
}
    }  continue {
        $r++
}

print RESPONSE <<"end_print";
</table><br>
<center>
<input type="submit" value="Finalize">
</center>
<p>
<center>
<a href="file:///home/jasoni/personal/temp/select.html">Back to Table Builder</a>
</center>
</body></html>
end_print
close (RESPONSE);

open (RESPONSE, "/home/jasoni/temp/preview.html");
while (<RESPONSE>)  {
    print;
}
close (RESPONSE);